with Ada.Containers.Bounded_Doubly_Linked_Lists;
limited with Legend.Stages;
with Ada.Finalization;
with Legend.Controls;
with Legend.Colors;
package Legend.Roles is

   type Action_Code is new Integer;
   package Action_Codes is
      Unknown : constant Action_Code := 0;
      Stand   : constant Action_Code := 1;
      Walk    : constant Action_Code := 2;
   end Action_Codes;

   -- 人物
   type Role_Type is tagged limited private;

   procedure Setup (
      this : in out Role_Type;
      Stage : not null access Stages.Stage_Type'Class;
      State : not null access Hero_Type
      );

   function Prototype (
      this : Role_Type
      ) return access Hero_Type;

   function Visible (this : Role_Type) return Boolean with Inline;

   function Face (
      this : in out Role_Type
      ) return Face_Type 
      with Inline;

   procedure Face (
      this : in out Role_Type; 
      Face : Face_Type;
      Walk : Boolean := False
      );

   procedure Horse_Movies (
      this : in out Role_Type;
      Movies : Horse_Movie_Groups_Type
      ) with Inline;

   function Horse (
      this  : Role_Type
      ) return Horse_Type;

   procedure Horse (
      this  : in out Role_Type;
      Horse : Horse_Type
      );

   function Position (
      this : in out Role_Type
      ) return Point_Type 
      with Inline;

   procedure Position (
      this : in out Role_Type;
      Position : Point_Type
      );

   function Next_Position (
      this : in out Role_Type
      ) return Point_Type;

   procedure Search_Route (
      this : in out Role_Type;
      Where : Point_Type
      );

   procedure Clear_Route (this : in out Role_Type);

   procedure Move_To (this : in out Role_Type; Where : Point_Type);

   procedure Speed (
      this  : in out Role_Type;
      Speed : Duration
      );

   procedure Action (
      this : in out Role_Type;
      Code : Action_Code
      );

   function Current_Action (
      this : in out Role_Type
      ) return Action_Code
      with Inline;

   function Is_Walking (
      this : in out Role_Type
      ) return Boolean 
      with Inline;

   procedure Stand (this : in out Role_Type);

   procedure Start_Walk (this : in out Role_Type);

   procedure Stop_Walk (this : in out Role_Type);

   -- 使用Set_XXX修改各种属性时, 应当使用Begin_Update禁止更新角色画布
   -- 修改完毕, 使用End_Update允许更新角色画布
   procedure Begin_Update (this : in out Role_Type) with Inline;

   procedure End_Update (this : in out Role_Type) with Inline;

   procedure Show (this : in out Role_Type);

   procedure Hide (this : in out Role_Type);

   procedure Focus (this : in out Role_Type);

   procedure Emit (
      this  : in out Role_Type; 
      S     : UTF8_String;
      Color : Color_Type := Colors.White;
      Life  : Duration := 1.0
      );

   procedure Play (
      this    : in out Role_Type;
      Movie   : Movie_Type;
      Expired : Duration
      );

   procedure Play (
      this  : in out Role_Type;
      Movie : Movie_Type;
      Count : Natural := 0 -- 0 means infinite loop
      );

   procedure On_Timer (
      this : in out Role_Type; 
      Timer : Hash_Type;
      Count : Natural
      );

   function Show_Route (this : Role_Type) return Boolean;

   procedure Show_Route (this : in out Role_Type; Visible : Boolean := True);

   procedure Use_Item (this : in out Role_Type; Item : in out Item_Type);

   subtype Role_Class is Role_Type'Class;

   type Role_Pointer is access all Role_Class;

   procedure Dispose (this : in out Role_Pointer);

   package Role_Lists is
      new Bounded_Doubly_Linked_Lists (Role_Pointer);

   -- 人物列表
   -- type Roles_Type is array (Uint16_t range <>) of Role_Pointer;

   subtype Roles_Type is Role_Lists.List;

   type Roles_Access is access Roles_Type;

   procedure Dispose (list : in out Roles_Access);

private

   type Role_Label_Type (
      Owner : not null access Role_Type'Class
      ) is new Controls.Label_Type with null record;

   overriding
   procedure Prepare (this : in out Role_Label_Type);



   -- 人物走动控制
   -- 走动通过时钟控制
   -- 玩家用方向控制走动时, 按下箭头表示开始走动, 松开箭头表示停止走动
   -- 走动位置的计算, 理论上应该是 position + speed * t

   type Route_Overlay_Type is record
      Where : Point_Type;
      Value : Uint16_t;
   end record;

   package Route_Overlay_Lists is new Doubly_Linked_Lists(Route_Overlay_Type);

   type Role_Type is new Ada.Finalization.Limited_Controlled with record
      F_State            : access Hero_Type;
      F_Stage            : access Legend.Stages.Stage_Type'Class; -- 所在场景
      F_Updating         : Boolean;
      F_Visible          : Boolean;
      F_Position         : Point_Type; -- 在地图上的位置
      F_Speed            : Duration;   -- 每秒走动步数
      F_Face             : Face_Type;  -- 朝向
      F_Horse            : Horse_Type; -- 坐骑
      F_Movie            : Movie_Type; -- 当前动画 
      F_Horse_Movies     : Horse_Movie_Groups_Type; -- 各种坐骑动画
      F_Walk_Timer       : Hash_Type;
      F_Current_Action   : Action_Code;
      F_Label            : aliased Role_Label_Type(Role_Type'Unrestricted_Access);
      F_Route            : Point_Lists.List; -- 行动路线
      F_Route_Overlay    : Route_Overlay_Lists.List; -- 行动路线
      F_Route_Visible    : Boolean := False;
   end record;

   procedure Reset_Movie (this : in out Role_Type);

   procedure On_Before_Walk (
      this   : in out Role_Type; 
      Target : Point_Type;
      Allow  : in out Boolean
      );

   procedure Walk (this : in out Role_Type);

   procedure On_After_Walk (this : in out Role_Type) is null;

   overriding
   procedure Initialize (this : in out Role_Type);

   overriding
   procedure Finalize (this : in out Role_Type);

end Legend.Roles;
